perm filename ITMSUB.F4[XX,LCS]7 blob
sn#197686 filedate 1976-01-23 generic text, type T, neo UTF8
00100 C**** ITMSUB, BMS, METER, RNOTE, MAKNUM, IABS, DRWNT, RHORZ, RDRAW
00200 C ********** WHOLE & HALF RESTS, BEAMS ******
00300 SUBROUTINE ITMSUB
00400 IMPLICIT INTEGER(A-Q,S-Z)
00500 REAL DIS,DISX,HGT,POS,CENTR,STFF,HGT1
00600 COMMON/STF/RSTFAC(-3/4),RSTJ2/MIN/MINI,RMINI
00700 COMMON R2,JA,CENTR,J2,RJQ(20),JQ(16),RE,RF,RG,RH/BM/RA,RC,RJY
00800 COMMON/POSI/STFF(-3/4),JJ2,POS/PLTR/PLT,RHT,DIS
00900 COMMON/ALF/QQ(3),RST7,RST18,R3Q,JY,RD,RX,RW,RJX,RJ,L,K,
01000 1 RJA,YY,DISX,HGT,RZ,INP(53)
01100 COMMON/DAT/RACNT(65),RDOT(17),XAC(7),RNOTE(22),RACCI(22),NACCI(3)
01200 EQUIVALENCE (J3,JQ(1)),(J4,JQ(2)),(J5,JQ(3)),(R5,RJQ(3))
01300 1,(R6,RJQ(4)),(J7,JQ(5)),(J8,JQ(6)),(J9,JQ(7)),(J10,JQ(8))
01400 1,(J11,JQ(9)),(J6,JQ(4)),(R9,RJQ(7)),(R8,RJQ(6)),(R3,RJQ(1))
01500 1 ,(R7,RJQ(5)),(R4,RJQ(2)),(R9,RJQ(7)),(R10,RJQ(8)),(RX3,RJQ(20))
01600 DATA R14/14.54/,RTF/3.0/,RHGT/48.0/,R2HGT/96.0/,RBM/.83/
01700 1,RDBR/ 3.5/,RBR/.33/,RBX/ 7.0/
01800 C RDBR IS SPACER FOR DBL BAR.
01900 C RTF COMPENSATES FOR BAD PLANNING.
02000 RST7=RSTJ2*7.
02100 RST18=RSTJ2*18.
02200 C TO COMPENSATE FOR NOTE #3 COMING AT POS=0
02300
02400 R3Q=R3
02500 C NEXT DRAWS STRAIGHT LINES
02600
02700 RD=R4*RST7
02800 RA=0
02900 RX=RTF*RSTJ2+POS
03000 C SOMEDAY ADD < RDIS=1./DIS > TO REPLACE ALL 1./DIS'S
03100 IF(J5.EQ.50)GO TO 300
03200 C 50 IS FOR CRESC., DECRESC. AND BOXES
03300 IF(R6.NE.0)GO TO 401
03400 IF(J7.NE.0)GO TO 401
03500 C FOR BAR LINES
03600 4000 JA=44
03700 C CODE # IS CHNGD SO BAR LINES WON'T AFFECT MAX. HGT.
03800 C ↑↑↑↑↑↑↑↑↑ FOR VERTICAL WIGGLE (P6=0, P7=-1)
03900 DBR=0
04000 IF(J4.LT.1000)GO TO 400
04100 C J4=1001 = DBL BAR, =1401 = DBL BAR WITH RT. ONE HEAVY: J5=1=DOTS ADDED
04200 CK J4=J4-1000
04300 CK DBR=-1
04400 CK400 J7=(J4/100)*DIS
04500 DBR=J4/1000
04600 J4=J4-DBR*1000
04700 C DBR=1 HEAVY BAR IS ON RT. =2 ON LEFT. =3 IN MIDDLE.
04800 9400 RD=RDBR+RDBR*RSTJ2
04900 C TO SPACE THIN BAR FROM HEAVY
05000 IF(J5.EQ.0)GO TO 400
05100 C NEXT ADDS REPEAT DOTS TO DBL BAR.
05200 L=J4
05300 RJ=L/100
05400 IF(RJ.EQ.0)RJ=6.*RSTJ2
05500 C HEAVY BAR WILL BE 5 LINES WIDE.
05600 RZ=R3
05700 J4=0
05800 C MUST BE 0 FOR DOTS IN 'NOTWRT'
05900 IF(DBR.EQ.0)DBR=J5
06000 J5=0
06100 C J5=1 RPT ←, =2 RPT →, =3 RPT ↔
06200 RJA=RD*2.
06300 C TO SPACE DOTS, NOT ACCURATE FOR VERY SMALL OR VERY LARGE SIZE FACTORS
06400 JY=DBR
06500 IF(DBR.LT.2)GO TO 8400
06600 R3=RJA+RJ+RZ
06700 7400 DO 3400 K=J2,MOD(L,100)+J2-1
06800 RSTJ2=RSTFAC(K)
06900 POS=STFF(K)
07000 R4=6
07100 CALL CENTX
07200 C SPACES DOTS OUT FROM BAR
07300 CALL RDRAW(1,17.0,RDOT,RSTJ2,R3,CENTR+RSTJ2,RSTJ2)
07400 C GO GET THE DOT
07500 R4=8
07600 CALL CENTX
07700 3400 CALL RDRAW(1,17.0,RDOT,RSTJ2,R3,CENTR+RSTJ2,RSTJ2)
07800 JY=JY-1
07900 IF(JY.LT.2)GO TO 4400
08000 8400 R3=RZ-RJA-4.*RSTJ2
08100 GO TO 7400
08200 C DO I NEED ANY MORE RESETS????
08300 4400 J4=L
08400 J7=RJ*DIS
08500 GO TO 5400
08600 400 IF(J5.NE.0)GO TO 9400
08700 K=J4/100
08800 C K IS FOR SPACING OF THIN BAR IN HEAVY-THIN ORDER
08900 J7=K*DIS
09000 C J7=NUM OF STROKES -- BASED ON FINAL SIZE FACTOR (DIS)
09100 5400 L=MOD(J4,100)
09200 IF(L.EQ.0)L=1
09300 L=L+J2-1
09400 C J4=401 MAKES 4X THICK BARLINE - ONE STAFF
09500 RA=RTF
09600 IF(L.LE.4)GO TO 2400
09700 L=4
09800 RA=300.
09900 C FOR EXTENDING BARS ABOVE STAFF 4
10000 2400 RY=RSTFAC(L)
10100 RZ=R3Q
10200 C SAVE IT FOR DBL RPT BAR.
10300 RY=STFF(L)+(RA+56.)*RY
10400 1400 RA=1
10500 IF(PLT.GE.0)GO TO 140
10600 J7=J7+1
10700 RA=1./DIS
10800 C BAR LINES PLOT AS DOUBLE THICKNESS
10900 140 RJX=R3Q
11000 42 CALL LINES(R3Q,RX,3)
11100 RJ=-1.
11200 RW=RY
11300 406 CALL LINES(RJX,RY,2)
11400 IF(J10.EQ.0)GO TO 411
11500 C P10 WILL THICKEN VERTICAL (OR MOSTLY VERTICAL) LINES.
11600 J7=J10*DIS
11700 J10=0
11800 RA=1./DIS
11900 411 IF(J7.GT.0)GO TO 409
12000 IF(DBR.LE.0)RETURN
12100 RY=RW
12200 CK R3Q=R3Q-RDBR
12300 RA=RZ-RD
12400 IF(DBR.NE.1)RA=RJX+RD-1.
12500 DBR=DBR-2
12600 R3Q=RA
12700 GO TO 1400
12800 CC411 IF(J7.LE.0)RETURN
12900 C FOR 'HEAVY' LINE.
13000 409 RJX=RJX+RA
13100 CALL LINES(RJX,RY,2)
13200 J7=J7-1
13300 RY=RW
13400 IF(RJ)RY=RX
13500 RJ=-RJ
13600 GO TO 406
13700 CC43 IF(RA.LE.0)RETURN
13800 C HOW IS RA.NE.0?
13900 C DRAWS BAR LINES. J4>0 CAUSES FULL LINE.
14000 CC403 RA=RA-3.72
14100 CC R3Q=R3Q+22
14200 CC RJX=RJX+22
14300 C DO ABOVE NEED *RSTJ2? ************
14400 C **** BASED ON '596' ****
14500 CC GO TO 42
14600
14700 C FOR CRESC., DECRESC.
14800 300 IF(R7.EQ.0)R7=2.3
14900 IF(R7.EQ.-1.)R7=-2.3
15000 RA=ABS(R7/2.0)*RST7
15100 C AMOUNT OF SPREAD
15200 RJ=R3Q
15300 RX=RX-RST18+RD
15400 IF(R8.NE.0)GO TO 302
15500 C JUMP TO MAKE BOX
15600 R6=RHORZ(R6)
15700 IF(R7)GO TO 301
15800 RJ=R6
15900 R6=R3Q
16000 301 CALL LINX(RJ,RX+RA,R6,RX)
16100 CALL LINES(RJ,RX-RA,2)
16200 C FOR CRESC, DECRESC:4 POS1, STF, HGT, 50, POS1, +OR-N(0=2.3,-1=-2.3)
16300 CC IF(PLT.NE.-2)RETURN
16400 IF(PLT.GE.0)RETURN
16500 C THIS MAKES ALL CRESC. DBL THICKNESS AT PRINT TIME.
16600 IF(J8)RETURN
16700 RX=RX+1./DIS
16800 J8=-1
16900 C FOR DOUBLE THICKNESS
17000 GO TO 301
17100
17200 302 R8=R8*RST7
17300 R9=R9*RST7
17400 IF(R9.EQ.0)R9=R8
17500 C R9=0 MAKES SQUARE
17600 R3=R3Q-R8/2.
17700 RX=RX-R9/2.
17800 J10=J10*DIS
17900 C DRAWS BOX, CENTER IS IN MIDDLE
18000 C 4,POS,STF,NT#,50,0,0,,SIZ1[BY NT#S],SIZ2
18100 1302 CALL LINX(R3,RX,R3+R8,RX)
18200 CALL LINES(R3+R8,RX+R9,2)
18300 CALL LINES(R3,RX+R9,2)
18400 CALL LINES(R3,RX,2)
18500 IF(J10.EQ.0)RETURN
18600 J10=J10-1
18700 RJ=1./DIS
18800 R3=R3-RJ
18900 R8=R8+RJ+RJ
19000 RX=RX-RJ
19100 R9=R9+RJ+RJ
19200 GO TO 1302
19300 C TO THICKEN BOXES.
19400
19500 1401 R4=2.0
19600 C FOR HEAVY BRACK.
19700 RA=RSTJ2*RBX
19800 RX=RX-RA
19900 C THE BOTTOM
20000 L=J4+J2-1
20100 R6=RTF
20200 IF(L.LE.4)GO TO 4401
20300 L=4
20400 R6=300.
20500 4401 RA=STFF(L)
20600 C SAVE FOR POS. OF BRACK. END ON UPPER STAFF.
20700 RJY=RSTFAC(L)
20800 RY=RA+R6*RJY+RJY*56.+RJY*RBX
20900 C THE TOP
21000 R5=9.5
21100 GO TO 2401
21200
21300 C DASHES
21400 401 POS=POS-RST18
21500 C********* 27/9/72 ******
21600 IF(J7.LE.0)GO TO 407
21700 IF(J7.EQ.4)GO TO 1401
21800 IF(J7.NE.3)GO TO 4001
21900 C NEXT IS FOR VARIABLE LARGE BRACKET. P7=3 P10=THICK. P5=HGT P6=P3
22000 2401 JA=3
22100 IF(J10.EQ.0)J10=5
22200 C DEFAULT VALUE FOR THICKNESS =5
22300 R4=R4-RBR
22400 J9=0
22500 J5=35
22600 C THE NUM FOR THE LITTLE END ITEMS
22700 CC RY=R6-2.1*RSTJ2
22800 R6=3
22900 R7=0
23000 C DOES LOWER ONE FIRST. ITEM IS IN 'CLEF3.DMD' ON DAT.LCS
23100 IF(J8.NE.2)CALL CLEFS
23200 C P8=1=BOTTOM 1/2 BRACK. ONLY: =2=TOP 1/2 ONLY: 0=COMPLETE
23300 R4=R5-RBR
23400 R6=3
23500 R7=-3
23600 C TURNS IT UPSIDE DOWN.
23700 CC JA=3
23800 IF(J7.NE.4)GO TO 3401
23900 POS=RA
24000 R4=R4*RJY/RSTJ2
24100 C TO ADJUST HEIGHT OF BRACK END WHEN STAVES ARE DIFF. SIZES.
24200 3401 IF(J8.NE.1)CALL CLEFS
24300 R3Q=R3Q-12.0*RSTJ2
24400 IF(J7.NE.4)GO TO 407
24500 J7=0
24600 GO TO 140
24700
24800 4002 J5=4
24900 C FOR CURVY BRACKET. P6 CAN CHANGE WIDTH.
25000 R8=0
25100 J4=J4+J2-1
25200 R7=(.3136*RSTFAC(J4)+.0056*(STFF(J4)-STFF(J2)))/RSTJ2
25300 C .0056=.0392/7.(THE MAGIC NUM FOR VERT SIZE OF BRACK.) .3136=8*.0392
25400 C ADD DIST BETWEEN BOTTOM OF STAVES TO HEIGHT OF TOP STAFF
25500 IF(R6.EQ.0)R6=1.+R7/20.
25600 JA=3
25700 R4=2.3
25800 C C BECAUSE BRACK DOESN'T REALLY GO UP FROM 0 ?!?X*⊗
25900 CALL CLEFS
26000 RETURN
26100
26200 4001 IF(J7.EQ.5)GO TO 4002
26300 IF(R8.EQ.0)R8=.8
26400 C P8 CAN SET SIZE OF DASH
26402 RZ=5.96*RSTJ2
26405 RJ=R8*RZ
26410 RZ=R9*RZ
26420 IF(R9.EQ.0)RZ=RJ
26430 C P9 SETS SPACE BETWEEN DASHES. (CAN BE DIFFERENT FROM P8)
26440 R8=RJ
26450 R9=RZ
26500 RD=RD+POS
26510 RJX=RD
26800 CC IF(J7.EQ.1)GO TO 402
26900 C =1 =DASHES. P6=P3=VERTICAL; P4=P5=HORIZ.; OTHERWISE, SLOPE.
27000 J6=ROFF(RHORZ(R6))
27100 J3=J6-J3
27110 J4=J5-J4
27120 RJY=RD
27160 C SAVE FOR THICK LINES
27400 RA=J6
27430 C RA IS HORIZ. GOAL FOR DASHES.
27600 CC RJX=R3Q
27800 402 RY=POS+R5*RST7
27810 IF(J4.EQ.0)GO TO 41
27820 RH=RY-RD
27830 C TOTAL HEIGHT DIFF.
27840 RX=RA-R3
27850 C TOTAL LENGTH DIFF.
27900 RH=RH/RX
28000 41 L=3
28100 K=2
28200 416 CALL LINES(R3Q,RD,L)
28300 IF(J3.EQ.0)GO TO 412
28400 C JUMP FOR VERTICAL DASH
28410 IF(J3.GT.0)GO TO 422
28420 IF(R3Q.LE.RA)GO TO 413
28425 C THIS IF P6 IS LESS THAN P3
28430 R3Q=R3Q-RJ
28440 GO TO 423
28500 422 IF(R3Q.GE.RA)GO TO 413
28600 C JUMP IF ALL DONE
28700 R3Q=R3Q+RJ
28710 423 IF(J4.NE.0)RD=RJY+RH*(R3Q-R3)
28720 C FINDS HEIGHT OF RIGHT SIDE OF SLOPE
28800 414 CALL EXCH(L,K)
28810 CALL EXCH(RJ,RZ)
28820 C EXCH. SPACE AND DASH SIZE.
28900 GO TO 416
28950 412 IF(J4.GT.0)GO TO 424
28960 IF(RD.LE.RY)GO TO 413
28970 RD=RD-RJ
28980 C THIS IF P5 IS LESS THAN P4.
28990 GO TO 414
29000 424 IF(RD.GE.RY)GO TO 413
29100 C JUMP IF DONE
29200 RD=RD+RJ
29300 GO TO 414
29400 413 IF(J10.GT.0)GO TO 420
29410 IF(J11.EQ.0)RETURN
29415 IF(J3)RJ=-RJ
29420 IF(L.EQ.3)R3Q=R3Q-RJ
29430 RX=R8
29440 IF(J11)RX=-RX
29450 CALL LINX(R3Q,RD,R3Q,RD+RX)
29460 C PUTS BRACK END ON DASHED LINE. (P11=1 OR -1)
29470 RETURN
29480
29500 C NEXT FOR THICK DASHES
29600 420 J10=J10-1
29700 IF(J3.EQ.0)GO TO 415
29800 R3Q=R3
29900 RJY=RJY+1./DIS
29950 RD=RJY
30000 GO TO 417
30100 415 R3Q=R3Q+1./DIS
30200 RD=RJX
30210 417 RJ=R8
30220 RZ=R9
30230 C FOR THICK DASHES.
30300 GO TO 41
30400
30500
30600 407 RX=RD+POS
30700 RY=R5*RST7+POS
30800 IF(J7.EQ.3)GO TO 140
30900 CALL NOZERO(R9)
31000 IF(J7.EQ.-1)GO TO 408
31100 C FOR 'TR' J7=-2, 'ARPEGG' J7=-1, STRAIGHT LINES J7=0
31200 CC WHY THE IFIX???? RJX=IFIX(RHORZ(R6))
31300 RJX=IFIX(ROFF(RHORZ(R6)))
31400 C ALL THIS CRAP SO IT WILL MATCH UP WITH P3 WHEN NECESSARY.
31500 IF(J7.EQ.0)GO TO 42
31600 RY=R9*RST7+RX
31700 CALL NOZERO(R8)
31800 4041 RZ=RX
31900 RH=RY
32000 C SAVE FOR THICK WIGGLES
32100 CALL LINES(R3Q,RX,3)
32200 C DRAWS STRAIGHT LINES. ETC.
32300 R9=R3Q
32400 RJ=RY
32500 RW=3.*RSTJ2*R8
32600 RA=RW*2.5
32700 C P8=HORZ. WIGGLE SIZE; P9=VERT. SIZE
32800 404 R9=R9+RA
32900 CALL LINES(R9,RJ,2)
33000 R9=R9+RW
33100 CALL LINES(R9,RJ,2)
33200 405 CALL EXCH(RX,RJ)
33300 IF(R9.LT.RJX)GO TO 404
33400 IF(J10.LE.0)RETURN
33500 RX=RZ+1./DIS
33600 RY=RH+1./DIS
33700 J10=J10-1
33800 GO TO 4041
33900 C P10= + NUM OF THICKNESSES TO WIGGLE
34000
34100 408 IF(RX.GT.RY)CALL EXCH(RX,RY)
34200 RZ=R9*RSTJ2*5.96
34300 C USE P9 TO SET WIGGLE WIDTH. P8 TO SET HGT.
34400 CALL NOZERO(R8)
34500 RD=R8*RST7*.5
34600 RJ=RD
34700 IF(RD.LT.1.)RD=1.
34800 421 R9=RX
34900 RW=R3Q
35000 RA=RZ+R3Q
35100 CALL LINES(RW,R9,3)
35200 410 R9=R9+RJ
35300 CALL LINES(RA,R9,2)
35400 R9=R9+RD
35500 CALL LINES(RA,R9,2)
35600 CALL EXCH(RA,RW)
35700 IF(R9.LT.RY)GO TO 410
35800 IF(J10.LE.0)RETURN
35900 R3Q=R3Q+1./DIS
36000 J10=J10-1
36100 GO TO 421
36200 C VERTICAL WIGGLE P10=+ NUM OF THICKNESSES.
36300 END